410 Games Neste/Magister SuperGames.iso/variados/TetrisforWindows/TETRIS.PAS

Pascal/Delphi Source File | 1995-10-30 | 24.9 KB | 833 lines

unit Tetris;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWinG, ExtCtrls, StdCtrls, Buttons, MMSystem;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Timer1: TTimer;
    Header1: THeader;
    procedure AppOnActivate(Sender: Tobject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure drop_block(Sender: TObject);
    procedure pause(Sender: TObject);
  end;

var
  Form1: TForm1;

{**********************************************************************}
implementation

{$R *.DFM}
type
  _block = record                         {Tetris block}
     data : array[0..63] of byte;         {bitmap}
     x: integer;                          {x coordinate}
     y: integer;                          {y coordinate}
     pattern : array [0..8] of byte;      {block pattern}
  end;

var
  datapath : String;
  dc : hDC;                               {device context}
  hpal : hPalette;                        {palette handle}
  RGBvalues : array [0..767] of byte;

  vb1,vb2             : integer;          {virtual buffer handles}
  vb_width, vb_height : longint;          {dimensions of main virtual buffer}
  cxWidth, cyHeight   : integer;          {dimensions of window}

  board : array [-3..21,-2..11] of boolean; {20 x 10 grid with edges}
  block : array[0..7] of _block;          {array of block records}

  explosion1 : array[0..31]  of byte;     {explosion bitmaps}
  explosion2 : array[0..25]  of byte;
  langolier1 : array[0..142] of byte;     {little munchy critters}
  langolier2 : array[0..143]  of byte;
  current    : integer;                   {number of current block (1-8)}
  next_block : integer;                   {next block becomes current}
  do_rotate  : boolean;                   {okay to rotate?}
  released   : boolean;                   {button press released?}
  moved      : boolean;                   {block moved left or right?}
  can_move   : boolean;                   {can move?}
  score      : word;                      {points are kept here }
  Jay_Leno   : boolean;                   {Jay speaks once per game}

const
  pattern :    array[0..7,0..8] of byte = (
    (0,0,0, 1,1,1, 0,0,0),                {this is how blocks are formed}
    (0,0,0, 0,1,1, 1,1,0),
    (0,0,0, 1,1,1, 0,0,1),
    (0,0,0, 0,1,1, 0,1,1),
    (0,0,0, 0,1,0, 1,1,1),
    (0,0,0, 0,0,1, 1,1,1),
    (0,0,0, 1,0,1, 1,1,1),
    (0,0,0, 1,1,0, 0,1,1));

{forward declarations}
procedure build_screen;               forward;
function  can_move_down: boolean;     forward;
function  can_move_left: boolean;     forward;
function  can_move_right: boolean;    forward;
procedure check_rows;                 forward;
procedure clear_block;                forward;
procedure fill_color_palette;         forward;
procedure fix_grid;                   forward;
procedure get_blocks;                 forward;
procedure new_game;                   forward;
procedure new_block;                  forward;
procedure put_block;                  forward;
procedure remove_row(row: integer);   forward;
procedure rotate;                     forward;
procedure tetris_paste;               forward;
procedure paste(x1,x2,y1,y2:integer); forward;

{**********************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hpal);
  Invalidate;
end;

{**********************************************************************}
procedure TForm1.FormCreate(Sender: TObject);
var
  i : integer;
begin
  { set up the device context }
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);

  { set up the logical palette }
  fill_color_palette;
  hpal := fg_logpal(10,236,RGBvalues);
  fg_realize(hpal);

  {initialize the virtual buffers}
  fg_vbinit;
  vb2 := fg_vballoc(88,16); {temporary storage for explosions}
  fg_vbopen(vb2);
  fg_vbcolors;
  vb1 := fg_vballoc(vb_width,vb_height); {primary virtual buffer}
  fg_vbopen(vb1);
  fg_vbcolors;

  {set up the application's OnActivate handler }
  Application.OnActivate := AppOnActivate;

  {assume resources stored in same directory as EXE file}
  datapath := paramstr(0);
  i := length(datapath);
  while i > 0 do
    begin
      If datapath[i] = '\' Then
      begin
        datapath := copy(datapath,1,i);
        i := 1;
      end;
      dec(i);
    end;

  {read the graphics data & prepare to play game}
  get_blocks;
  build_screen;
  randomize;
  new_game;
  new_block;
  do_rotate := False;
  Timer1.Enabled := True;
end;

{**********************************************************************}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(vb1);
  fg_vbfree(vb2);
  fg_vbfin;
  DeleteObject(hpal);
  ReleaseDC(Form1.Handle,dc);
end;

{**********************************************************************}
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,fg_getmaxx,0,fg_getmaxy,0,cxWidth,0,cyHeight);
end;

{**********************************************************************}
procedure TForm1.FormResize(Sender: TObject);
begin
  cxWidth := ClientWidth-1;
  cyHeight := ClientHeight-1;
end;

{**********************************************************************}
procedure TForm1.pause(Sender: TObject);
begin
  if timer1.enabled = True then
    timer1.enabled := False
  else
    timer1.enabled := True;
end;

{**********************************************************************}
procedure TForm1.drop_block(Sender: TObject);
var
  x1,x2 : longint;
  game_over : boolean;
  msg: tMsg;
  xmin,xmax,ymin,ymax : integer;
begin
  {check for game over}
  game_over := False;
  if (block[current].y = 24) and (not can_move_down) then
  begin
    game_over := True;
    timer1.enabled := False;
    if  MessageDlg ('Game Over. Play Again?',mtCustom,
       [mbYes,mbNo], 0) = mrYes then
    begin
      build_screen;
      new_game;
      new_block;
      timer1.enabled := True;
    end
    else
      Halt(0);
  end;
  if game_over then exit;

  xmin := block[current].x;
  xmax := block[current].x+24;
  ymin := block[current].y-24;
  ymax := block[current].y;

  clear_block;
  moved := True;
  if can_move then
    begin
    {move left}
    if (fg_kbtest(75)=1) and (can_move_left) then
    begin
      block[current].x := block[current].x-8;
      dec(xmin,8);
      moved := True;
      can_move := False;
    end

    {move right}
    else if (fg_kbtest(77)=1) and (can_move_right) then
    begin
      block[current].x := block[current].x+8;
      inc(xmax,8);
      moved := True;
      can_move := False;
    end

    {drop down}
    else if (fg_kbtest(80)=1) and (block[current].y > 40) then
    begin
      while(can_move_down) do
        inc(block[current].y,2);
      ymax := block[current].y;
      put_block;
      fix_grid;
      check_rows;
      new_block
    end
    else
    begin
      moved := False;
      can_move := True;
    end
  end
  else
  begin
    moved := False;
    can_move := True;
  end;

  {rotate only when y coord falls on byte boundary}
  if (fg_kbtest(72) = 1)then
  begin
    if  released = True then
      do_rotate := True;
    released := False;
  end
  else
    released := True;

  if (do_rotate) and (block[current].y mod 8 = 0) then
  begin
    rotate;
    moved := True;
    do_rotate := False;
  end;

  {go down}
  if not moved then
  begin
    {can move down?}
    if (block[current].y mod 8 = 0) then
    begin
      if (not can_move_down) then
      begin
        put_block;
        fix_grid;
        check_rows;
        new_block ;
      end
      else
        inc(block[current].y,2)
    end
    else
      inc(block[current].y,2);
  end;

  if block[current].y > ymax then
    ymax := block[current].y;
  {redraw the screen}
  put_block;
  tetris_paste;
  Header1.Sections.strings[1] := IntToStr(score);
end;

{**********************************************************************}
procedure build_screen;
begin
  fg_erase;
  fg_setcolor(48);
  fg_rect(80,159,25,184);
  fg_boxdepth(2,2);
  fg_setcolor(50);
  fg_box(78,161,23,186);
  fg_setcolor(55);
  fg_box(78,163,23,188);
end;

{**********************************************************************}
function can_move_down : boolean;
var
 row, col: integer;
 r, c: integer;
 i: integer;
begin
  can_move_down := True;
  col := (block[current].x-80) div 8;
  row := (block[current].y-24) div 8 + 1;

  if ((block[current].pattern[0]=1) and (board[row,col]=True))     or
     ((block[current].pattern[1]=1) and (board[row,col+1]=True))   or
     ((block[current].pattern[2]=1) and (board[row,col+2]=True))   or
     ((block[current].pattern[3]=1) and (board[row-1,col]=True))   or
     ((block[current].pattern[4]=1) and (board[row-1,col+1]=True)) or
     ((block[current].pattern[5]=1) and (board[row-1,col+2]=True)) or
     ((block[current].pattern[6]=1) and (board[row-2,col]=True))   or
     ((block[current].pattern[7]=1) and (board[row-2,col+1]=True)) or
     ((block[current].pattern[8]=1) and (board[row-2,col+2]=True)) then
    can_move_down := False;
end;

{**********************************************************************}
function can_move_left : boolean;
var
 row, col: integer;
begin
  can_move_left := True;
  col := ((block[current].x-80) div 8)-1; {column to right of block}
  row := (block[current].y-24) div 8;   {row at bottom of block}
  if ((block[current].pattern[0]=1) and (board[row,  col]=True))   or
     ((block[current].pattern[3]=1) and (board[row-1,col]=True))   or
     ((block[current].pattern[6]=1) and (board[row-2,col]=True))   or
     ((block[current].pattern[1]=1) and (board[row,  col+1]=True)) or
     ((block[current].pattern[4]=1) and (board[row-1,col+1]=True)) or
     ((block[current].pattern[7]=1) and (board[row-2,col+1]=True)) or
     ((block[current].pattern[2]=1) and (board[row,  col+2]=True)) or
     ((block[current].pattern[5]=1) and (board[row-1,col+2]=True)) or
     ((block[current].pattern[8]=1) and (board[row-2,col+2]=True)) then
    can_move_left := False;

  {Because of smooth vertical scrolling, block may overlap two grid
   rows. Better check them both.}
  if block[current].y mod 8 > 0 then
  inc(row);
  if ((block[current].pattern[0]=1) and (board[row,  col]=True))   or
     ((block[current].pattern[3]=1) and (board[row-1,col]=True))   or
     ((block[current].pattern[6]=1) and (board[row-2,col]=True))   or
     ((block[current].pattern[1]=1) and (board[row,  col+1]=True)) or
     ((block[current].pattern[4]=1) and (board[row-1,col+1]=True)) or
     ((block[current].pattern[7]=1) and (board[row-2,col+1]=True)) or
     ((block[current].pattern[2]=1) and (board[row,  col+2]=True)) or
     ((block[current].pattern[5]=1) and (board[row-1,col+2]=True)) or
     ((block[current].pattern[8]=1) and (board[row-2,col+2]=True)) then
    can_move_left := False;
end;

{**********************************************************************}
function can_move_right : boolean;
var
 row, col: integer;
begin
  can_move_right := True;
  col := (block[current].x-80) div 8+3;
  row := (block[current].y-24) div 8;
  if ((block[current].pattern[2]=1) and (board[row,  col]=True))   or
     ((block[current].pattern[5]=1) and (board[row-1,col]=True))   or
     ((block[current].pattern[8]=1) and (board[row-2,col]=True))   or
     ((block[current].pattern[1]=1) and (board[row,  col-1]=True)) or
     ((block[current].pattern[4]=1) and (board[row-1,col-1]=True)) or
     ((block[current].pattern[7]=1) and (board[row-2,col-1]=True)) or
     ((block[current].pattern[0]=1) and (board[row,  col-2]=True)) or
     ((block[current].pattern[3]=1) and (board[row-1,col-2]=True)) or
     ((block[current].pattern[6]=1) and (board[row-2,col-2]=True)) then
    can_move_right := False;

  {Because of smooth vertical scrolling, block may overlap two grid
   rows. Better check them both.}
  if block[current].y mod 8 > 0 then
  inc(row);
  if ((block[current].pattern[2]=1) and (board[row,  col]=True))   or
     ((block[current].pattern[5]=1) and (board[row-1,col]=True))   or
     ((block[current].pattern[8]=1) and (board[row-2,col]=True))   or
     ((block[current].pattern[1]=1) and (board[row,  col-1]=True)) or
     ((block[current].pattern[4]=1) and (board[row-1,col-1]=True)) or
     ((block[current].pattern[7]=1) and (board[row-2,col-1]=True)) or
     ((block[current].pattern[0]=1) and (board[row,  col-2]=True)) or
     ((block[current].pattern[3]=1) and (board[row-1,col-2]=True)) or
     ((block[current].pattern[6]=1) and (board[row-2,col-2]=True)) then
    can_move_right := False;
end;

{**********************************************************************}
procedure check_rows;
var
  occupied: boolean;
  row, i: integer;
begin
  {can we remove any fully covered rows?}
  row := 20;
  while row > 0 do
  begin
    occupied := True;
    i := 0;
    while ((i < 10) and occupied) do
    begin
      occupied := board[row,i];
      inc(i);
    end;
    if not occupied then
       dec(row)
    else
       remove_row(row);
  end;
end;

{**********************************************************************}
procedure clear_block;
var
  i,j,x,y: integer;
begin
  fg_setcolor(48);
  fg_setclip(80,159,25,184);
  for i := 0 to 2 do
  begin
    y := block[current].y-(i*8);
    for j := 0 to 2 do
    begin
      x := block[current].x+(j*8);
      if (block[current].pattern[i*3+j] = 1)then
         fg_clprect(x,x+7,y-7,y);
    end;
  end;
  fg_setclip(0,239,0,199);
end;

{**********************************************************************}
const
colors : array [0..707] of byte = (
21,63,21, 21,63,63, 63,21,21, 63,21,63, 63,63,21, 63,63,63, 59,59,59, 55,55,55,
52,52,52, 48,48,48, 45,45,45, 42,42,42, 38,38,38, 35,35,35, 31,31,31, 28,28,28,
25,25,25, 21,21,21, 18,18,18, 14,14,14, 11,11,11,  8, 8, 8, 63, 0, 0, 59, 0, 0,
56, 0, 0, 53, 0, 0, 50, 0, 0, 47, 0, 0, 44, 0, 0, 41, 0, 0, 38, 0, 0, 34, 0, 0,
31, 0, 0, 28, 0, 0, 25, 0, 0, 22, 0, 0, 19, 0, 0, 16, 0, 0, 63,54,54, 63,46,46,
63,39,39, 63,31,31, 63,23,23, 63,16,16, 63, 8, 8, 63, 0, 0, 63,42,23, 63,38,16,
63,34, 8, 63,30, 0, 57,27, 0, 51,24, 0, 45,21, 0, 39,19, 0, 63,63,54, 63,63,46,
63,63,39, 63,63,31, 63,62,23, 63,61,16, 63,61, 8, 63,61, 0, 57,54, 0, 51,49, 0,
45,43, 0, 39,39, 0, 33,33, 0, 28,27, 0, 22,21, 0, 16,16, 0, 52,63,23, 49,63,16,
45,63, 8, 40,63, 0, 36,57, 0, 32,51, 0, 29,45, 0, 24,39, 0, 54,63,54, 47,63,46,
39,63,39, 32,63,31, 24,63,23, 16,63,16,  8,63, 8,  0,63, 0,  0,63, 0,  0,59, 0,
 0,56, 0,  0,53, 0,  1,50, 0,  1,47, 0,  1,44, 0,  1,41, 0,  1,38, 0,  1,34, 0,
 1,31, 0,  1,28, 0,  1,25, 0,  1,22, 0,  1,19, 0,  1,16, 0, 54,63,63, 46,63,63,
39,63,63, 31,63,62, 23,63,63, 16,63,63,  8,63,63,  0,63,63,  0,57,57,  0,51,51,
 0,45,45,  0,39,39,  0,33,33,  0,28,28,  0,22,22,  0,16,16, 23,47,63, 16,44,63,
 8,42,63,  0,39,63,  0,35,57,  0,31,51,  0,27,45,  0,23,39, 54,54,63, 46,47,63,
39,39,63, 31,32,63, 23,24,63, 16,16,63,  8, 9,63,  0, 1,63,  0, 0,63,  0, 0,59,
 0, 0,56,  0, 0,53,  0, 0,50,  0, 0,47,  0, 0,44,  0, 0,41,  0, 0,38,  0, 0,34,
 0, 0,31,  0, 0,28,  0, 0,25,  0, 0,22,  0, 0,19,  0, 0,16, 60,54,63, 57,46,63,
54,39,63, 52,31,63, 50,23,63, 47,16,63, 45, 8,63, 42, 0,63, 38, 0,57, 32, 0,51,
29, 0,45, 24, 0,39, 20, 0,33, 17, 0,28, 13, 0,22, 10, 0,16, 63,54,63, 63,46,63,
63,39,63, 63,31,63, 63,23,63, 63,16,63, 63, 8,63, 63, 0,63, 56, 0,57, 50, 0,51,
45, 0,45, 39, 0,39, 33, 0,33, 27, 0,28, 22, 0,22, 16, 0,16, 63,58,55, 63,56,52,
63,54,49, 63,53,47, 63,51,44, 63,49,41, 63,47,39, 63,46,36, 63,44,32, 63,41,28,
63,39,24, 60,37,23, 58,35,22, 55,34,21, 52,32,20, 50,31,19, 47,30,18, 45,28,17,
42,26,16, 40,25,15, 39,24,14, 36,23,13, 34,22,12, 32,20,11, 29,19,10, 27,18, 9,
23,16, 8, 21,15, 7, 18,14, 6, 16,12, 6, 14,11, 5, 10, 8, 3,  0, 0, 0,  0, 0, 0,
 0, 0, 0,  0, 0, 0,  0, 0, 0,  0, 0, 0,  0, 0, 0,  0, 0, 0, 49,10,10, 49,19,10,
49,29,10, 49,39,10, 49,49,10, 39,49,10, 29,49,10, 19,49,10, 10,49,12, 10,49,23,
10,49,34, 10,49,45, 10,42,49, 10,31,49);

{**********************************************************************}
procedure fill_color_palette;
begin
  fg_mapdacs(colors,RGBvalues,236);
end;

{**********************************************************************}
procedure fix_grid;
var
  i,j: integer;
  row,col: integer;
  x,y: integer;
begin
   col := (block[current].x-80) div 8;
   row := (block[current].y-24) div 8;
   if (block[current].pattern[0] = 1) then board[row,col]     := True;
   if (block[current].pattern[1] = 1) then board[row,col+1]   := True;
   if (block[current].pattern[2] = 1) then board[row,col+2]   := True;
   if (block[current].pattern[3] = 1) then board[row-1,col]   := True;
   if (block[current].pattern[4] = 1) then board[row-1,col+1] := True;
   if (block[current].pattern[5] = 1) then board[row-1,col+2] := True;
   if (block[current].pattern[6] = 1) then board[row-2,col]   := True;
   if (block[current].pattern[7] = 1) then board[row-2,col+1] := True;
   if (block[current].pattern[8] = 1) then board[row-2,col+2] := True;

  {adjust the score}
  inc(score,10);
end;

{**********************************************************************}
procedure get_blocks;
var
  num, y: integer;
begin
  {display the graphics (simple RLE)}
  fg_move(0,87);
  fg_showspr(datapath+'tetris.spr'+Chr(0),16);
  y := 7;

  {get first 4 blocks}
  for num := 0 to 3 do
  begin
   fg_move(0,y);
   fg_getimage(block[num].data,8,8);
   y := y + 8;
   move(pattern[num],block[num].pattern,9);
  end;

  {get next 4 blocks}
  y := 7;
  for num := 4 to 7 do
  begin
    fg_move(8,y);
    fg_getimage(block[num].data,8,8);
    y := y + 8;
    move(pattern[num],block[num].pattern,9);
  end;

  {get the other bitmaps}
  fg_setcolor(1);
  fg_move(0,47);
  fg_getmap(explosion2,2,16);
  fg_move(0,60);
  fg_getmap(explosion1,2,13);
  fg_move(0,74);
  fg_getimage(langolier1,11,13);
  fg_move(0,87);
  fg_getimage(langolier2,12,12);
end;

{**********************************************************************}
procedure new_block;
var
  x,y,i,j: integer;
  count: integer;
begin
  {start a new random block at top of board}
  current := next_block;
  next_block := random(8);
  count := 1;
  while next_block = current do
  begin
    inc(count);
    next_block := random(8);
    if count > 10 then
    begin
      randomize;
      count := 1;
    end;
  end;
  block[current].x := 112;
  block[current].y := 24;
  move(pattern[current,0],block[current].pattern,9);

  {put the next block in the upper left corner}
  fg_setcolor(0);
  fg_rect(20,44,30,60);
  for i := 0 to 2 do
  begin
    y := i*8;
    for j := 0 to 2 do
    begin
      x := j*8;
      fg_move(20+x,60-y);
      if block[next_block].pattern[i*3+j] = 1 then
         fg_clpimage(block[next_block].data,8,8);
    end;
  end;
  fg_vbscale(0,fg_getmaxx div 4,0,fg_getmaxy div 3,0,cxWidth div 4,0,cyHeight div 3);
end;

{**********************************************************************}
procedure new_game;
var
  i,j: integer;
begin
  {initialize board by setting center and top grid elements to False}
  for i := -3 to 20 do
    for j := 0 to 9 do
       board[i,j] := False;

  {set bottom row (not visible) to True to stop blocks }
  for j := -2 to 9 do
    board[21,j] := True;

  {set left and right sides (not visible) to True to stop blocks}
  for i := -3 to 20 do
  begin
    board[i,-1] := True;
    board[i,-2] := True;
    board[i,10] := True;
    board[i,11] := True;
  end;

  {clear background}
  fg_setcolor(48);
  fg_rect(80,159,25,184);

  {set some globals}
  can_move := True;
  score := 0;
  next_block := random(8);
end;

{**********************************************************************}
procedure paste(x1,x2,y1,y2:integer);

{blit an area of a virtual buffer proportionatly scaled within a window}
var
  cx1,cx2,cy1,cy2: longint;
begin

  {calculate window coords based on buffer coords}
  cx1 := cxWidth*longint(x1) div vb_width + 1;
  cx2 := cxWidth*longint(x2) div vb_width + 1;
  cy1 := cyHeight*longint(y1) div vb_height + 1;
  cy2 := cyHeight*longint(y2) div vb_height + 1;

  {check boundary conditions}
  if x1 < 0 then x1 := 0;
  if x2 > vb_width then x2 := vb_width;
  if y1 < 0 then y1 := 0;
  if y2 > vb_height then y2 := vb_height;
  if x2 < x1 then x2 := x1;
  if y2 < y1 then y2 := y1;

  if cx1 < 0 then cx1 := 0;
  if cx2 > cxWidth then cx2 := cxWidth;
  if cy1 < 0 then cy1 := 0;
  if cy2 > cyHeight then cy2 := cyHeight;
  if cx2 < cx1 then cx2 := cx1;
  if cy2 < cy1 then cy2 := cy1;

  {do the blit}
  fg_vbscale(x1,x2,y1,y2,cx1,cx2,cy1,cy2);
end;

{**********************************************************************}
procedure put_block;
var
  i,j,x,y: integer;
begin
  fg_setclip(80,159,25,184);
  for i := 0 to 2 do
  begin
    y := i*8;
    for j := 0 to 2 do
    begin
      x := j*8;
      fg_move(block[current].x+x,block[current].y-y);
      if block[current].pattern[i*3+j] = 1 then
         fg_clpimage(block[current].data,8,8);
    end;
  end;
  fg_setclip(0,239,0,199);
end;

{**********************************************************************}
procedure remove_row(row: integer);
var
  i,x,x2,y: integer;
  color, old_color: integer;
  result: boolean;
  snd : string;
  flg: word;
  pc: Pchar;

begin
  snd := datapath+'eating.wav'+chr(0);
  pc := @snd[1];
  flg := snd_Async+snd_NoDefault;

  {refresh the screen and wait a bit}
  tetris_paste;
  fg_waitfor(3);
  result := sndPlaySound(pc,flg);

  {copy the row plus some extra to another virtual buffer}
  y := row*8+24;
  fg_vbcopy(76,163,y-11,y+4,0,15,vb1,vb2);

  {draw the munchie critter in the first virtual buffer and blit}
  fg_move(76,y+4);
  fg_drwimage(langolier2,12,12);
  tetris_paste;
  fg_waitfor(3);

  {move through all the blocks in the row}
  for i := 0 to 9 do
  begin

    {get the color of the current block from second virtual buffer}
    x := i*8+80;
    fg_vbopen(vb2);
    x2 := i*8+4;
    color := fg_getpixel(x2,8);

    {now erase that block}
    fg_setcolor(48);
    fg_rect(x2,x2+7,4,11);

    {copy remains of row to first virtual buffer (make a clean copy)}
    fg_vbcopy(0,87,0,15,76,y+4,vb2,vb1);
    fg_vbopen(vb1);

    {add the explosions (munchy remnants)}
    fg_setcolor(color);
    fg_move(x-4,y+4);
    fg_drawmap(explosion1,2,13);
    if i > 0 then
    begin
       fg_setcolor(old_color);
       fg_move(x-12,y+4);
       fg_drawmap(explosion2,2,15);
    end;

    {add the munchy critter}
    if i < 9 then
    begin
      fg_move(x+8,y+4);
      if i mod 2 = 0 then
        fg_drwimage(langolier1,11,13)
      else
        fg_drwimage(langolier2,12,12);
    end;
    old_color := color;

    {blit to screen}
    tetris_paste;
    fg_waitfor(3);
  end;

  {make a final copy}
  fg_vbcopy(0,87,0,15,76,y+4,vb2,vb1);

  {move all the rows down: copy graphics and board data}
  for i := row downto 2 do
  begin
    y := i*8+24;
    fg_vbcopy(80,159,y-15,y-8,80,y,vb1,vb1);
    move(board[i-1,0],board[i,0],10);
  end;
  tetris_paste;

  {adjust the score}
  inc(score,100);

  {make a surprising sound}
  if (row = 10) and Jay_Leno then
  begin
    snd := datapath+'jayleno.wav'+chr(0);
    result := sndPlaySound(pc,flg);
    Jay_Leno := False;
  end;
end;

{**********************************************************************}
procedure rotate;
var
  temp: array[0..8] of byte;
  i: integer;
  row,col: integer;
const
  index: array [0..8] of byte = (6,3,0,7,4,1,8,5,2);
begin
  {don't rotate the square block}
  if current = 3 then exit;
  move(block[current].pattern,temp,9);

  {check if legal to rotate}
  row := (block[current].y - 24) div 8;
  col := (block[current].x - 80) div 8;

  if ((temp[index[0]] = 1) and (board[row,col]     = True)) or
     ((temp[index[1]] = 1) and (board[row,col+1]   = True)) or
     ((temp[index[2]] = 1) and (board[row,col+2]   = True)) or
     ((temp[index[3]] = 1) and (board[row-1,col]   = True)) or
     ((temp[index[4]] = 1) and (board[row-1,col+1] = True)) or
     ((temp[index[5]] = 1) and (board[row-1,col+2] = True)) or
     ((temp[index[6]] = 1) and (board[row-2,col]   = True)) or
     ((temp[index[7]] = 1) and (board[row-2,col+1] = True)) or
     ((temp[index[8]] = 1) and (board[row-2,col+2] = True)) then
   exit;
  for i := 0 to 8 do
    block[current].pattern[i] := temp[index[i]];
end;

{**********************************************************************}
procedure tetris_paste;
var
  cx1,cx2: integer;
begin
  cx1 := cxWidth div 3;
  cx2 := cxWidth * 2 div 3;
  fg_vbscale(80,159,0,199,cx1,cx2,0,cyHeight);
end;

{**********************************************************************}

initialization
  vb_width  := 240;
  vb_height := 200;
  Jay_Leno  := True;
end.